home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 26 / Cream of the Crop 26.iso / program / p063b9s.zip / UNIT / LIST.PAS < prev    next >
Pascal/Delphi Source File  |  1997-03-02  |  41KB  |  1,243 lines
  1. UNIT List;
  2. {╔══════════════════════════════════════════════════════════════════════════╗}
  3. {║ BBS Filelist generator                        Last changed: 02.03.97  SA ║}
  4. {║                                                                          ║}
  5. {║                         (C) Copyright 1989-97 by                         ║}
  6. {║       Dan Wulff, Jens Sandalgaard, Steen Christensen & S¢ren Ager        ║}
  7. {║                                                                          ║}
  8. {║ This source may not be given to anybody, without the written permission  ║}
  9. {║ from The Portal Team.                                                    ║}
  10. {╚══════════════════════════════════════════════════════════════════════════╝}
  11. {$I POPDEFS.Inc}
  12.  
  13. INTERFACE
  14.  
  15. USES Use32;
  16.  
  17. PROCEDURE ListMain;
  18.  
  19. IMPLEMENTATION
  20.  
  21. USES Dos, OpDos, OpString, OpDate, OpRoot, OpWindow,
  22.      Globals, Areamisc, Util, StrUtil, FileUtil, LogFile, OproUtil,
  23.      Nodelist, PoPTypes,NetFile, OpLarray
  24. {$IFDEF MSGOBJECT}
  25.      ,MKFile, MKMsgAbs, MkObject, MKGlobT
  26. {$ENDIF}
  27.      ;
  28.  
  29.  
  30.   PROCEDURE ListMain;
  31.   const
  32.     topmax      = 50;
  33.     MaxDupes    = 30000;
  34.  
  35.   TYPE
  36.     TDupeRec = RECORD
  37.       FileName    : S12;
  38.       Area        : S9;
  39.       Size        : LongInt;
  40.       Dupet       : Boolean;
  41.     END;
  42.  
  43.     TOkCheckRec = RECORD
  44.       NodeStat    : Byte;
  45.       FilePath    : StringPtr;
  46.       KeyLevelPwd : Boolean;
  47.     END;
  48.  
  49.     TOkCheckType = Array[0..MaxAreas] of TOkCheckRec;
  50.  
  51.     TopFilesRec = RECORD
  52.       Name        : S60;
  53.       Times       : Word;
  54.       Area        : Word;
  55.     END;
  56.  
  57.     TopFilesType = Array[1..TopMax] of TopFilesRec;
  58.  
  59.     StatistikRec=Record
  60.       Files     : Word;
  61.       Bytes     : LongInt;
  62.       Pos       : LongInt;
  63.     END;
  64.  
  65.     StatistikType= Array[1..MaxAreas] of StatistikRec;
  66.     AreaFreqLevelType=Array[0..MaxAreas] of Byte;
  67.   VAR
  68.     OkCheckFile : ^TOkCheckType;
  69.     Statistik   : ^StatistikType;
  70.     BufSiz      : Word;
  71.     i,a,b       : Integer;
  72.     ReturnCode  : Integer;
  73.     Tbdir       : FilesRec;
  74.     FILES       : ^FilesTab;
  75.     FilesBBS    : ^FilesBBStab;
  76.     NumFiles,
  77.     NumfilesBBS : Word;
  78.     dt          : DateTime;
  79.     FileAge     : Date;
  80.     F_List      : PBufTextFile; (* Fillisten som den skal se ud          *)
  81.     F_News      : PBufTextFile; (* NewsList - komplet                    *)
  82.     F_OkBim     : PBufTextFile; (* Bimodem ok-FILE                       *)
  83.     F_TMP       : PBufTextFile; (* DIVERSE                               *)
  84.     F_File      : FILE;         (* FILE                                  *)
  85.     OkFile      : TNetFile;     (* Portal Ok-FILE                        *)
  86.     NumDupes    : Word;         (* Indeholder antallet af filer i Dupes  *)
  87.     Dupes       : OpArray;
  88.     Dupe        : TDupeRec;
  89.     TempString  : STRING;
  90.     DatePicture : STRING[11];
  91.     AreaNum     : Word;
  92.     NewsHeaderAdded : Boolean;
  93.     TopFiles    : ^TopFilesType;
  94.     NewFilesAdded,
  95.     CrapFile,
  96.     DoDupeCheck,
  97.     DupesInLog,
  98.     LastWasFile : Boolean;
  99.  
  100.     TotalBytes,
  101.     BytesInArea : LongInt;
  102.     TotalExisting,
  103.     ExistingInArea,
  104.     TotalMissing,
  105.     MissingInArea,
  106.     TotalFiles,
  107.     FilesInArea : Integer;
  108.     StatStart,
  109.     TopStart     : Word;      {Her starter Statistik og Toplist - FOR seek ved insert}
  110.     ListWin1     : WindowPtr;
  111.     ListWin2     : WindowPtr;
  112.     TmpWin       : WindowPtr;
  113.     Area         : AreaTabPtr;
  114.     ViHarSnydt   : Boolean;
  115.     AreaFreqLevel: ^AreaFreqLevelType;
  116.     TmpDate      : Date;
  117.     FooterStartPos : LongInt;
  118.  
  119.   LABEL
  120.     SnydeFidus;
  121.  
  122. {$IFDEF MSGOBJECT}
  123.   Procedure PostStatMsg;
  124.   VAR
  125.     Msg : AbsMsgPtr;
  126.   BEGIN
  127. (*
  128.   If OpenMsgArea(Msg, 'SC:\MSG\LOCAL') Then
  129.     BEGIN
  130.       Msg^.StartNewMsg;
  131.       Msg^.SetFrom('PoP-List');
  132.       Msg^.SetTo(Cfg.sysop);
  133.       Msg^.SetSubj('Statistics');
  134.       Msg^.SetPriv(True);
  135.       Msg^.SetDate(DateStr(GetDosDate));
  136.       Msg^.SetTime(TimeStr(GetDosDate));
  137.       Msg^.SetLocal(True);
  138.       Msg^.SetOrig(Cfg.Addresses[Cfg.MainAdrNum]);
  139.       Msg^.SetDest(Cfg.Addresses[Cfg.MainAdrNum]);
  140.       Msg^.DoStringLn('');
  141.       Msg^.DoStringLn('PoP-List statistics:');
  142.       Msg^.DoStringLn('');
  143.       Msg^.DoStringLn('Total Files   :'+LONGINTFORM('#,###,###',TotalFiles));
  144.       Msg^.DoStringLn('Total Existing:'+LONGINTFORM('#,###,###',TotalExisting));
  145.       Msg^.DoStringLn('Total Missing :'+LONGINTFORM('#,###,###',TotalMissing));
  146.       Msg^.DoStringLn('Total KBytes  :'+LONGINTFORM('#,###,###',TotalBytes));
  147.       Msg^.DoStringLn('');
  148.       Msg^.DoStringLn('--- PoP-List v'+ver);
  149.       Msg^.DoStringLn(' * Origin: Now you are playing with Power... Portal of Power! (0:0/0.0)');
  150.       Msg^.WriteMsg;
  151.       CloseMsgArea(Msg);
  152.     END;
  153. *)
  154.   END;
  155. {$ENDIF}
  156.  
  157.   PROCEDURE UpdateScreen;
  158.   BEGIN
  159.     ListWin2^.wFasttext('Area no.    : '+Pad(Trim(Area^[i]^.Tag^),10),2,2);
  160.     ListWin2^.wFasttext('Area desc.  : '+Pad(Copy(Area^[i]^.Title^,1,45),45),3,2);
  161.     ListWin2^.wFasttext(LONGINTFORM('  #,###,###,###',FilesInArea)+LONGINTFORM('   #,###,###,###',ExistingInArea)+
  162.       LONGINTFORM('  #,###,###,###',missingInArea)+LONGINTFORM('  #,###,###,###',(BytesInArea DIV 1024)),6,17);
  163.     ListWin2^.wFasttext(LONGINTFORM('  #,###,###,###',TotalFiles)+LONGINTFORM('   #,###,###,###',TotalExisting)+
  164.       LONGINTFORM('  #,###,###,###',Totalmissing)+LONGINTFORM('  #,###,###,###',TotalBytes),7,17);
  165.   END;
  166.  
  167.  
  168.   PROCEDURE ShowScreen(OnOff:Boolean);
  169.   BEGIN
  170.     IF OnOff THEN
  171.     BEGIN
  172.       MyWin(ListWin1,25,2,55,9,2,'PoP-List current function',False);
  173.       MyWin(ListWin2,1,12,80,23,2,'PoP-List status display',False);
  174.       ListWin2^.wFasttext('                          Total        Existing        Missing         KBytes',5,1);
  175.       ListWin2^.wFasttext('Current area:',6,2);
  176.       ListWin2^.wFasttext('All areas   :',7,2);
  177.       ListWin1^.wFastText('Reading FileAreas',1,6);
  178.       ListWin1^.wFastText('Reading FILES.BBS',2,6);
  179.       ListWin1^.wFastText('Processing FILES.BBS',3,6);
  180.       ListWin1^.wFastText('Writing filelists',4,6);
  181.       ListWin1^.wFastText('Looking for dupes',5,6);
  182.       ListWin1^.wFastText('Cleaning up',6,6);
  183.     END ELSE
  184.     BEGIN
  185.       KillWindow(ListWin2);
  186.       KillWindow(ListWin1);
  187.     END;
  188.   END;
  189.  
  190.   PROCEDURE Arrow(yy:byte);
  191.   Var
  192.     zy : Byte;
  193.   BEGIN
  194.     FOR zy:=1 TO 6 DO
  195.       IF zy=yy THEN
  196.         ListWin1^.wFastText('══',zy,2)
  197.       Else
  198.         ListWin1^.wFastText('   ',zy,2);
  199.   END;
  200.  
  201.   FUNCTION IncludeArea(CONST Tag:S20):BOOLEAN;
  202.   VAR
  203.     y:BYTE;
  204.     s:S20;
  205.   BEGIN
  206.     IncludeArea:=True;
  207.     s:=StUpCase(Trim(Tag));
  208.     FOR y:= 1 TO 11 DO
  209.       IF s=StUpCase(Trim(Cfg.ListFiles.PrivateAreas[y])) THEN
  210.       BEGIN
  211.         IncludeArea:=False;
  212.         Break;
  213.       END;
  214.   END;
  215.  
  216.   PROCEDURE AddFile(F1, F2: PBufTextFile);
  217.   VAR
  218.     s : STRING;
  219.   BEGIN
  220.     WHILE NOT F1^.Eof DO
  221.     BEGIN
  222.       F1^.ReadLn(S);
  223.       F2^.WriteLn(S);
  224.     END;
  225.   END;
  226.  
  227.   PROCEDURE CheckPortalOkFile;
  228.   VAR
  229.     OkFileRec:TOkFile;
  230.     x,
  231.     Count : Word;
  232.  
  233.     FUNCTION ExistInPopOk(CONST S: STRING):Boolean;
  234.     VAR
  235.       Found:Boolean;
  236.       i    : Word;
  237.     BEGIN
  238.       Found:=False;
  239.       FOR i:=1 TO Count DO
  240.       BEGIN
  241.         IF (StUpCase(AddBackSlash(JustPathName(OkCheckFile^[i].FilePath^)))=AddBackSlash(StUpCase(s))) THEN
  242.         BEGIN
  243.           Found:=True;
  244.           IF (OkCheckFile^[i].KeyLevelPwd) THEN
  245.             AreaFreqLevel^[x]:=OkCheckFile^[i].NodeStat
  246.           ELSE
  247.             AreaFreqLevel^[x]:=0;
  248.           Break;
  249.         END;
  250.       END;
  251.       ExistInPopOk:=Found;
  252.     END;
  253.  
  254.     PROCEDURE OpenOkFile;
  255.     BEGIN
  256.       OkFile.Open(StartPath+PoPOkFileName,SizeOf(TOkFile),True);
  257.     END;
  258.  
  259.   BEGIN
  260.     FillChar(AreaFreqLevel^,SizeOf(AreaFreqLevelType),255);
  261.     New(OkCheckFile);
  262.     OpenOkFile;
  263.     Count:=0;
  264.     WHILE NOT OkFile.Eof DO
  265.     BEGIN
  266.       OkFile.Read(OkFileRec,NoKeep,Wait) ;
  267.       IF (TrimSpaces(OkFileRec.MagicName)='') THEN
  268.       BEGIN
  269.         Inc(Count);
  270.         OkCheckFile^[Count].NodeStat:=BYTE(OkFileRec.NodeStat)+1;
  271.         OkCheckFile^[Count].FilePath:=StringToHeap(StUpCase(AddBackSlash(JustPathName(OkFileRec.FilePath))));
  272.         IF (OkFileRec.Level+OkFileRec.Keys = 0) AND (TrimSpaces(OkFileRec.PassWord)='') THEN
  273.           OkCheckFile^[Count].KeyLevelPwd:=True
  274.         ELSE
  275.           OkCheckFile^[Count].KeyLevelPwd:=False;
  276.       END;
  277.     END;
  278.     FOR x:=1 TO AreaNum DO
  279.     BEGIN
  280.       IF IncludeArea(Area^[x]^.Tag^) THEN
  281.       BEGIN
  282.         IF NOT ExistInPopOk(Area^[x]^.Path^) THEN
  283.         BEGIN
  284.           IF Cfg.ListFiles.OkPortal THEN
  285.           BEGIN
  286.             AddLog('*','Adding '+Area^[x]^.path^+' To Portal OK-File');
  287.             FillChar(OkFileRec,SizeOf(OkFileRec),0);
  288.             OkFileRec.FilePath:=StUpCase(Addbackslash(Area^[x]^.Path^)+'*.*');
  289.             OkFile.PutRec(OkFileRec, OkFile.FileSize);
  290.             AreaFreqLevel^[x]:=1;
  291.           END;
  292.         END;
  293.       END;
  294.     END;
  295.  
  296.     FOR x:=1 TO Count DO
  297.       DisposeString(OkCheckFile^[x].FilePath);
  298.     Dispose(OkCheckFile);
  299.     OkFile.Close;
  300.   END;
  301.  
  302.   PROCEDURE POPfooter(f: PBufTextFile; Totals: Boolean);
  303.   BEGIN
  304.     f^.WriteLn('');
  305.     f^.WriteLn('');
  306.     IF Totals THEN
  307.     BEGIN
  308.       f^.WriteLn(center('Totals for all areas: '+Trimspaces(LongintForm('#####',TotalExisting))+' files, Using '
  309.                  +Trimspaces(LongIntForm('#,###',(Totalbytes div 1024)))+' Mb.',79));
  310.       f^.WriteLn('');
  311.     END;
  312.     f^.WriteLn('╒════════════════╡  Last updated: '+TodayString('dd-nnn-yyyy')+'  at  '+
  313.                CurrentTimeString('hh:mm:ss')+' ╞════════════════╕');
  314.     f^.WriteLn('│'+center('PoP-List v'+ver+' - a part of the Portal Of Power Mailer',76)+'│');
  315.     f^.WriteLn('├'+CharStr('─',76)+'┤');
  316.     f^.WriteLn('│                 (C) Copyright 1989-97 by The Portal Team                   │');
  317.     f^.WriteLn('│                             All Rights Reserved.                           │');
  318.     f^.WriteLn('╘'+CharStr('═',76)+'╛');
  319.   END;
  320.  
  321.   PROCEDURE HeaderText(f: PBufTextFile);
  322.   BEGIN
  323.     f^.WriteLn('╞════════════╤═══════╤═════════╤═════════════════════════════════════════════╡');
  324.     f^.WriteLn('│ Filename   │ Bytes │ Date    │ File-description                            │');
  325.     f^.WriteLn('╘════════════╧═══════╧═════════╧═════════════════════════════════════════════╛');
  326.   END;
  327.  
  328.   PROCEDURE WriteHeader(I:Word);
  329.   BEGIN
  330.     F_List^.WriteLn('');
  331.     F_List^.WriteLn('');
  332.     F_List^.WriteLn('');
  333.     F_List^.WriteLn('╒'+CharStr('═',76)+'╕');
  334.     F_List^.WriteLn('│'+center('('+Trim(Area^[i]^.tag^)+') '+Copy(Area^[i]^.Title^,1,76),76)+'│');
  335.     F_List^.WriteLn('├'+CharStr('─',76)+'┤');
  336.     F_List^.WriteLn('│ Bytes On-line:  '+LongIntForm('###.###.###',BytesInArea)+'     Files On-line: '+
  337.       LongIntForm('#.###',ExistingInArea)+'  Files Off-line:'+LongIntForm('#.###',MissingInArea)+' │');
  338.     HeaderText(F_List);
  339.     IF AreaFreqLevel^[i]<255 THEN
  340.       F_List^.WriteLn(center(Cfg.ListFiles.TXTFreq[AreaFreqLevel^[i]],78))
  341.     ELSE
  342.       F_List^.WriteLn('');
  343.     F_List^.WriteLn('');
  344.   END;
  345.  
  346.   PROCEDURE WriteNewsHeader;
  347.   BEGIN
  348.     IF F_News<>NIL THEN
  349.     BEGIN
  350.       F_News^.WriteLn('');
  351.       F_News^.WriteLn('');
  352.       F_News^.WriteLn('╒'+CharStr('═',76)+'╕');
  353.       F_News^.WriteLn('│'+center('('+Trim(Area^[i]^.tag^)+') '+Copy(Area^[i]^.Title^,1,76),76)+'│');
  354.       HeaderText(F_News);
  355.       F_News^.WriteLn('');
  356.     END;
  357.   END;
  358.  
  359.   PROCEDURE Top(CONST Filest: STRING; Areano: Integer);
  360.   VAR
  361.     z : Byte;
  362.   BEGIN
  363.     a:=GetDlC(FileSt);
  364.     IF (a > TopFiles^[Cfg.ListFiles.top].Times) AND (a>0) THEN
  365.     BEGIN
  366.       b:=Cfg.ListFiles.Top;
  367.       FOR z:=Cfg.ListFiles.Top downto 1 DO
  368.         IF a > TopFiles^[z].Times THEN b:=z;
  369.       IF B<>Cfg.ListFiles.Top THEN Move(TopFiles^[b],TopFiles^[b+1],SizeOf(TopFilesRec)*(Cfg.ListFiles.Top-b-1));
  370.       TopFiles^[b].Name:=Filest;
  371.       TopFiles^[b].Times:= a;
  372.       TopFiles^[b].Area:=areano;
  373.     END;
  374.   END;
  375.  
  376.   FUNCTION FindInDir(FileName: S12; Var Dinfo: FilesRec) : Integer;
  377.   VAR
  378.     top,bund,test : Integer;
  379.   BEGIN
  380.     top:=NumFiles;
  381.     bund:=1;
  382.     FileName:=StUpCase(Copy(FileName,1,pos(' ',FileName+' ')-1));
  383.     IF FileName<>'' THEN
  384.     BEGIN
  385.       REPEAT
  386.         test:=(top+bund) DIV 2;
  387.         IF Files^[test].Name>FileName THEN
  388.           top:=test-1
  389.         ELSE
  390.           IF Files^[test].Name<FileName THEN bund:=test+1;
  391.       UNTIL (top<=bund) OR (FileName=Files^[test].Name);
  392.       test:=(top+bund) DIV 2;
  393.       Dinfo:=Files^[Test];
  394.       IF Files^[test].Name<>FileName THEN test:=0;
  395.     END ELSE
  396.       test:=0;
  397.     FindInDir:=test;
  398.   END;
  399.  
  400.   PROCEDURE CalcStat;
  401.   VAR
  402.     ZZ : Word;
  403.   BEGIN
  404.     FOR zz:=1 TO NumFilesBBS DO
  405.     BEGIN
  406.       TempString:=FilesBBS^[zz]^.Tekst^;
  407.       IF HasFileName(TempString) THEN
  408.       BEGIN
  409.         Inc(FilesInArea);
  410.         IF FindInDir(TrimSpaces(Copy(TempString,1,12)), TbDir)<>0 THEN
  411.         BEGIN
  412.           Inc(ExistingInArea);
  413.           BytesInArea:=BytesInArea+TbDir.Size;
  414.         END ELSE
  415.           Inc(MissingInArea);
  416.       END;
  417.     END;
  418.     Statistik^[i].Files:=ExistingInArea;
  419.     Statistik^[i].Bytes:=BytesInArea;
  420.     Statistik^[i].Pos:=F_List^.Getpos;
  421.   END;
  422.  
  423.     FUNCTION SortDupeFile: Boolean;
  424.     VAR
  425.       Escaped : Boolean;
  426.  
  427.       PROCEDURE QuickSort(L, R : Word);
  428.         {-Non-recursive QuickSort per N. Wirth's "Algorithms AND Data Structures"}
  429.       const
  430.         StackSize = 20;
  431.       type
  432.         Stack = array[1..StackSize] of Word;
  433.       var
  434.         Lstack : Stack;          {Pending partitions, left edge}
  435.         Rstack : Stack;          {Pending partitions, right edge}
  436.         StackP : Integer;        {Stack Pointer}
  437.         Pl : Word;               {Left edge within partition}
  438.         Pr : Word;               {Right edge within partition}
  439.         StrPl, StrPr, Pivot :    TDupeRec;
  440.       BEGIN
  441. {$IFDEF LISTDEBUG}
  442.       Addlog(' ','DEBUG   : STARTING FileSort');
  443.       Addlog(' ','DEBUG   : MEMAVAIL:'+LongIntForm('#######',MemAvail));
  444.       Addlog(' ','DEBUG   : MAXAVAIL:'+LongIntForm('#######',MaxAvail));
  445. {$ENDIF}
  446.         {Initialize the stack}
  447.         StackP:=1;
  448.         Lstack[1]:=L;
  449.         Rstack[1]:=R;
  450.         Write('>>');
  451.  
  452.         {Repeatedly take top partition from stack}
  453.         repeat
  454.  
  455.           {Pop the stack}
  456.           L:=Lstack[StackP];
  457.           R:=Rstack[StackP];
  458.           Dec(StackP);
  459.           Write(#8'<'#8);
  460.  
  461.           {Sort current partition}
  462.           repeat
  463.  
  464.             {Load the pivot element}
  465.             Dupes.RetA(L+Random(R-L), 0, Pivot);
  466.             Pl:=L;
  467.             Pr:=R;
  468.  
  469.             {Swap items in sort order around the pivot index}
  470.             repeat
  471.               Dupes.RetA(Pl, 0, StrPl);
  472.               WHILE StrPl.FileName<Pivot.FileName DO
  473.               BEGIN
  474.                 Inc(Pl);
  475.                 Dupes.RetA(Pl, 0, StrPl);
  476.               END;
  477.               Dupes.RetA(Pr, 0, StrPr);
  478.               WHILE StrPr.FileName>Pivot.FileName DO
  479.               BEGIN
  480.                 Dec(Pr);
  481.                 Dupes.RetA(Pr, 0, StrPr);
  482.               END;
  483.               IF Pl <= Pr THEN
  484.               BEGIN
  485.                 IF Pl <> Pr THEN
  486.                 BEGIN
  487.                   {Swap the two elements}
  488.                   Dupes.SetA(Pl, 0, StrPr);
  489.                   Dupes.SetA(Pr, 0, StrPl);
  490.     {              Tmp:=SortPointer(Pl);
  491.                   SetPointer(SortPointer(Pr), Pl);
  492.                   SetPointer(Tmp, Pr); }
  493.                 END;
  494.                 IF Pl < 65535 THEN Inc(Pl);
  495.                 IF Pr > 0 THEN Dec(Pr);
  496.               END;
  497.               Escaped:=GotEsc;
  498.               IF Escaped THEN Exit;
  499.             until Pl > Pr;
  500.  
  501.             {Decide which partition TO sort next}
  502.             IF (Pr-L) < (R-Pl) THEN
  503.             BEGIN
  504.               {Left partition is bigger}
  505.               IF Pl < R THEN
  506.               BEGIN
  507.                 {Stack the request FOR sorting right partition}
  508.                 Inc(StackP);
  509.                 Lstack[StackP]:=Pl;
  510.                 Rstack[StackP]:=R;
  511.                 Write('>');
  512.               END;
  513.               {Continue sorting left partition}
  514.               R:=Pr;
  515.             END else
  516.             BEGIN
  517.               {Right partition is bigger}
  518.               IF L < Pr THEN
  519.               BEGIN
  520.                 {Stack the request FOR sorting left partition}
  521.                 Inc(StackP);
  522.                 Lstack[StackP]:=L;
  523.                 Rstack[StackP]:=Pr;
  524.                 Write('>');
  525.               END;
  526.               {Continue sorting right partition}
  527.               L:=Pl;
  528.             END;
  529.           until L >= R;
  530.         until StackP <= 0;
  531.         Write(#8'<'#8);
  532. {$IFDEF LISTDEBUG}
  533.       Addlog(' ','DEBUG   : Ending FileSort');
  534. {$ENDIF}
  535.       END;
  536.  
  537.     BEGIN
  538.       Escaped:=False;
  539.       Dec(NumDupes);
  540.       QuickSort(0,NumDupes);
  541.       SortDupeFile:=NOT Escaped;
  542.     END;
  543.  
  544.     FUNCTION SizeCheck(a,b:LongInt):Boolean; {Returns True IF less than Threshold}
  545.     VAR
  546.       c : longint;
  547.     BEGIN
  548.       IF (a=b) or (a=0) THEN
  549.       BEGIN
  550.         SizeCheck:=True;
  551.         Exit;
  552.       END;
  553.       c:=ABS(a-b);
  554.       SizeCheck:=((c*100) div a) < Cfg.ListFiles.Threshold;
  555.     END;
  556.  
  557.     PROCEDURE CheckDupeFile;
  558.     Var
  559.       ff: PBufTextFile;
  560.       n1,n2,
  561.       n,
  562.       FirstDupe,
  563.       LastDupe : Word;
  564.       Dupe1,
  565.       Dupe2    : TDupeRec;
  566.     BEGIN
  567.       Addlog('#','Loking for dupes');
  568. {$IFDEF LISTDEBUG}
  569.       Addlog(' ','DEBUG   : STARTING DupeCheck');
  570. {$ENDIF}
  571.       MyWin(TmpWin,15,9,65,11,2,'Dupe check in progress',False);
  572.       IF SortDupeFile THEN;
  573.       FirstDupe:=65535;
  574.       LastDupe:=0;
  575.       IF TrimSpaces(Cfg.ListFiles.DupeReport)='' THEN DupesInLog:=True Else DupesInLog:=False;
  576.       IF NOT DupesInLog THEN
  577.       BEGIN
  578.         New(ff, Init(Cfg.Listfiles.DupeReport, SCreate, 1024));
  579.         IF ff<>NIL THEN
  580.         BEGIN
  581.           ff^.WriteLn('╒'+CharStr('═',76)+'╕');
  582.           ff^.WriteLn('│'+Center('Dupe report',76)+'│');
  583.           ff^.WriteLn('╘'+CharStr('═',76)+'╛');
  584.           ff^.WriteLn('');
  585.         END ELSE
  586.           DupesInLog:=True;
  587.       END;
  588. {$IFDEF LISTDEBUG}
  589.       Addlog(' ','DEBUG   : Beginning to compare sorted files');
  590. {$ENDIF}
  591.       FOR n:=0 TO NumDupes-1 DO
  592.       BEGIN
  593.         Dupes.RetA(n,0,Dupe1);
  594.         Dupes.RetA(n+1,0,Dupe2);  {Originalen}
  595.         IF JustName(Dupe1.FileName)=JustName(Dupe2.FileName) THEN
  596.         BEGIN
  597.           IF FirstDupe=65535 THEN FirstDupe:=N;
  598.         END ELSE
  599.         BEGIN
  600.           IF FirstDupe<>65535 THEN
  601.           BEGIN
  602.             FOR n1:= FirstDupe TO N-1 DO
  603.             BEGIN
  604. {             FOR n2:= FirstDupe+1 TO n DO  }
  605.               FOR n2:= n1+1 TO n DO
  606.               BEGIN
  607.                 Dupes.RetA(n1,0,Dupe1);
  608.                 Dupes.RetA(n2,0,Dupe2);
  609.                 IF SizeCheck(Dupe1.Size,Dupe2.Size) THEN
  610.                 BEGIN {WriteToLog AND Set .Dupet=True}
  611.                   IF DupesInLog THEN
  612.                   BEGIN
  613.                     IF NOT Dupe1.Dupet THEN AddLog('*','Dupe: '+Dupe1.FileName+' ('
  614.                            +Longintform('##.###',(Dupe1.Size DIV 1024))+'K) in area: '+Dupe1.Area);
  615.                     IF NOT Dupe2.Dupet THEN AddLog('*','Dupe: '+Dupe2.FileName+' ('
  616.                            +Longintform('##.###',(Dupe2.Size DIV 1024))+'K) in area: '+Dupe2.Area);
  617.                   END ELSE
  618.                   BEGIN
  619.                     IF NOT Dupe1.Dupet THEN ff^.WriteLn(Dupe1.FileName+' ('
  620.                            +Longintform('##.###',(Dupe1.Size DIV 1024))+'K) in area: '+Dupe1.Area);
  621.                     IF NOT Dupe2.Dupet THEN ff^.WriteLn(Dupe2.FileName+' ('
  622.                            +Longintform('##.###',(Dupe2.Size DIV 1024))+'K) in area: '+Dupe2.Area);
  623.                   END;
  624.                   Dupe1.Dupet:=True;
  625.                   Dupe2.Dupet:=True;
  626.                   Dupes.SetA(n1,0,Dupe1);
  627.                   Dupes.SetA(n2,0,Dupe2);
  628.                 END;
  629.               END;
  630.             END;
  631.             FirstDupe:=65535;
  632.           END;
  633.         END;
  634.       END;
  635.       IF NOT DupesInLog THEN
  636.       BEGIN
  637.         POPFooter(ff,False);
  638.         Dispose(ff, Done);
  639.       END;
  640. {$IFDEF LISTDEBUG}
  641.       Addlog(' ','DEBUG   : Finished Comparing sorted files');
  642. {$ENDIF}
  643.       KillWindow(TmpWin);
  644.     END;
  645.  
  646.  
  647.   PROCEDURE ProcessFilesBBS(Nummer:Integer);
  648.   Var
  649.     ANumber,
  650.     TmpWord,
  651.     zz : Word;
  652.     F_Touch : FILE;
  653.  
  654.     PROCEDURE WriteLine(F: PBufTextFile);
  655.     VAR
  656.       Tmp,OutStr, Overlap : STRING;
  657.       i : Byte;
  658.     BEGIN
  659.       Tmp:=TrimLead(Copy(Tempstring,13,Length(TempString)-12));
  660.       IF (Cfg.BBS.BBSType=btMax) AND (Length(Tmp)>0) AND (Tmp[1]='/') THEN
  661.       BEGIN
  662.         i:=Pos(' ',Tmp);
  663.         IF i>0 THEN Delete(Tmp,1,i) ELSE Tmp:='';
  664.       END;
  665.  
  666.       IF (Cfg.AreaMan.InsDlCnt) AND (Cfg.AreaMan.DlCDigits<>0) THEN i:=Cfg.AreaMan.DlCDigits+3 ELSE i:=0;
  667.       WordWrap(Tmp,OutStr,Overlap,46,False);
  668.       f^.WriteLn(Form('  #######  ',TbDir.Size)+DMYtoDateString(DatePicture,Dt.day,Dt.Month,Dt.Year)+'  '+OutStr);
  669.       WHILE Overlap<>'' DO
  670.       BEGIN
  671.         WordWrap(Overlap,OutStr,Overlap,46-i,False);
  672.         f^.WriteLn(CharStr(' ',33+i)+OutStr);
  673.       END
  674.     END;
  675.  
  676.     function CheckCrapfiles(CONST s: STRING):boolean;
  677.     VAR
  678.       I : Byte;
  679.       HaveChar : Boolean;
  680.     BEGIN
  681.       I:=1;
  682.       HaveChar:=False;
  683.       WHILE (i<= Length(s)) AND NOT havechar DO
  684.       BEGIN
  685.         HaveChar:=NOT(s[i] In ['?','*','.']);
  686.         Inc(i);
  687.       END;
  688.       CheckCrapFiles:=HaveChar;
  689.     END;
  690.  
  691.     PROCEDURE DeleteCrap;
  692.     Var
  693.       z : Byte;
  694.       DirInfo: SearchRec;         { FOR Windows, use TSearchRec }
  695.     BEGIN
  696.       FOR z:=1 TO 10 DO
  697.         IF CheckCrapFiles(Cfg.ListFiles.CrapFiles[z]) THEN
  698.         BEGIN                          { FOR Windows, use faArchive }
  699.           FindFirst(Cfg.ListFiles.CrapFiles[z], Archive, DirInfo); { Same as DIR *.PAS }
  700.           WHILE DosError = 0 DO
  701.           BEGIN
  702.             IF DeleteFile(DirInfo.Name) THEN
  703.               AddLog('*', Pad(DirInfo.Name,12)+' in area '+Trim(Area^[Nummer]^.Tag^)+' deleted');
  704.             FindNext(DirInfo);
  705.           END;
  706.           FindClose(DirInfo);
  707.         END;
  708.     END;
  709.  
  710.   BEGIN
  711.     Arrow(2);
  712.     NumFilesBBS:=0;
  713.     FilesInArea:=0;
  714.     ExistingInArea:=0;
  715.     MissingInArea:=0;
  716.     BytesInArea:=0;
  717.     IF ChangeDir(Area^[Nummer]^.path^) THEN
  718.     BEGIN
  719.       IF NOT Str2Word(AREA^[Nummer]^.Tag^,ANumber) THEN ANumber:=0;
  720.       IF ReadFilesInArea(AREA^[Nummer]^.Fpath^,6,Files^,FilesBBS^,NumFilesBBS,NumFiles,ANumber) THEN
  721.       BEGIN
  722.         DeleteCrap;
  723.         IF Cfg.ListFiles.Adopt THEN
  724.         BEGIN
  725.           IF AdoptOrphans(True,False,FilesBBS^,Files^,NumFiles,NumFilesBBS,Cfg.ListFiles.AdoptComment) THEN
  726.           BEGIN
  727.             WriteCurrentFilesBBS(Area^[Nummer]^.Fpath^,NumFilesBBS,FilesBBS^,FALSE);
  728.           END;
  729.         END;
  730. {--     FreqOk:=UpDatePopOkFile(Area^[Nummer]^.path,Cfg.ListFiles.OkPortal); }
  731.         ChangeDir(StartPath);
  732.         Arrow(3);
  733.         CalcStat;
  734.         Inc(TotalFiles,FilesInArea);
  735.         Inc(TotalExisting,ExistingInArea);
  736.         TotalBytes:=TotalBytes+(BytesInArea DIV 1024);
  737.         Inc(TotalMissing,MissingInArea);
  738.         WriteHeader(Nummer);
  739.         NewsHeaderAdded:=False;
  740.         NewFilesAdded:=False;
  741.         CrapFile:=False;
  742.         LastWasFile:=False;
  743.         FOR ZZ:=1 TO NumFilesBBS DO
  744.         BEGIN
  745.           TempString:=FilesBBS^[zz]^.Tekst^;
  746.           IF Cfg.AreaMan.InsDlCnt THEN AddDlc(TempString);
  747.           IF ((HasFileName(TempString)) AND (NOT CrapFile)) THEN
  748.           BEGIN
  749.             LastWasFile:=True;
  750.             IF Cfg.ListFiles.Top <> 0 THEN top(TempString,i);   {I er stadig areanummeret}
  751.             F_List^.WriteNoLn(CPad(TempString,12));
  752.             ReturnCode:=FindInDir(TrimSpaces(Copy(TempString,1,12)),TbDir);
  753.             IF ReturnCode<>0 THEN
  754.             BEGIN
  755.               IF DoDupeCheck THEN     {Add2DupeFile(StUpCase(Copy(Pad(TempString,12),1,12)),AREA^[Nummer]^.Tag);}
  756.               BEGIN
  757.                 Dupe.FileName:=StUpCase(CPad(TempString,12));
  758.                 Dupe.Area:=AREA^[Nummer]^.Tag^;
  759.                 Dupe.Size:=TbDir.size;
  760.                 Dupe.Dupet:=False;
  761.                 Dupes.SetA(NumDupes,0,Dupe);
  762.                 Inc(NumDupes);
  763.               END;
  764.               UnpackTime(TbDir.Time,dt);
  765.               TmpDate:=DMYtoDate(Dt.Day,Dt.Month,Dt.Year);
  766.               IF (Cfg.ListFiles.Touch) AND (Today > 143540) THEN  {KUN Hvis TODAY>1992}
  767.                 IF (TmpDate > Today) or (TmpDate<139523) THEN  {Hvis >today or <01-01-82}
  768.                 BEGIN
  769.                   GetDate(Dt.Year,Dt.Month,Dt.Day,TmpWord);
  770.                   GetTime(Dt.Hour,Dt.Min,Dt.Sec,TmpWord);
  771.                   PackTime(Dt,TbDir.Time);
  772.                   TmpDate:=Today;
  773.                   Assign(F_Touch,AddBackSlash(Area^[Nummer]^.path^)+TbDir.Name); FileMode:=ShareRead+ShareDenyNone;
  774.                   Reset(F_Touch);
  775.                   IF IOResult=0 THEN
  776.                   BEGIN
  777.                     SetFTime(F_Touch,TbDir.time);
  778.                     Close(F_Touch);
  779.                   END;
  780.                   AddLog('*','Touched '+TbDir.Name+' in area: '+Trim(AREA^[Nummer]^.Tag^));
  781.                 END;
  782.               FileAge:=Today-TmpDate;
  783.               IF (FileAge<Cfg.ListFiles.NewsDays) AND (Fileage>=0) THEN
  784.               BEGIN
  785.                 IF NOT NewsHeaderAdded THEN
  786.                 BEGIN
  787.                   NewsHeaderAdded:=True;
  788.                   WriteNewsHeader;
  789.                 END;
  790.                 NewFilesAdded:=True;
  791.                 IF F_News<>NIL THEN
  792.                 BEGIN
  793.                   F_News^.WriteNoLn(CPad(TempString,12));
  794.                   WriteLine(F_News);
  795.                 END;
  796.               END;
  797.               WriteLine(F_List);
  798.             END Else
  799.             BEGIN
  800.               IF NOT CrapFile THEN
  801.               BEGIN
  802.                 F_List^.WriteLn('  Offline    N/A    '+Copy(Tempstring,13,255));
  803.               END;
  804.             END;
  805.           END else
  806.             IF NOT CrapFile THEN
  807.             BEGIN
  808.               IF (LastWasFile AND (TrimSpaces(TempString)<>'') ) THEN
  809.               BEGIN
  810.                 F_List^.WriteLn(CharStr(' ',33)+trimspaces(TempString));
  811.               END else
  812.               BEGIN
  813.                 F_List^.WriteLn(TempString);
  814.                 LastWasFile:=False;
  815.               END;
  816.             END;
  817.         END;
  818.       END;
  819.       DeallocateFiles(FilesBBS^,NumFilesBBS);
  820.       ChangeDir(StartPath);
  821.     END ELSE
  822.       CalcStat;
  823.   END;
  824.  
  825.   PROCEDURE IWriteLn(VAR F: FILE; CONST S: STRING);
  826.   Var
  827.     Result : Word;
  828.     ss     : STRING;
  829.   BEGIN
  830.     ss:=CPad(s,79)+#13+#10;
  831.     BlockWrite(F,SS[1],81,Result);
  832.   END;
  833.  
  834.   PROCEDURE WriteFooter(F: PBufTextFile);
  835.   BEGIN
  836.     f^.WriteLn('');
  837.     f^.WriteLn('╒'+CharStr('═',76)+'╕');
  838.     f^.WriteLn('│        PoP-List - Portal Of Power - (C) 1989-97 by The Portal Team         │');
  839.     f^.WriteLn('╘'+CharStr('═',76)+'╛');
  840.   END;
  841.  
  842.   PROCEDURE InsertStat(CONST FName: PathStr; Start: LongInt);
  843.   VAR
  844.     f      : FILE;
  845.     FT     : PBufTextFile;
  846.     s      : STRING;
  847.     x      : Word;
  848.     Len    : Byte;
  849.   BEGIN
  850.     IF Cfg.BBS.BBSType=btMax THEN Len:=9 ELSE Len:=3;
  851.     IF Cfg.ListFiles.Stat THEN
  852.     BEGIN
  853.       Assign(F,fName);FileMode:=ShareWrite+ShareDenyW;
  854.       Reset(F,1);
  855.       IF IOResult <> 0 THEN
  856.       BEGIN
  857.         AddLog('!','Error inserting Statistic-file - Ignoring!');
  858.         Exit;
  859.       END;
  860.       Seek(F,Start);
  861.       IWriteLn(F,'┌'+CharStr('─',75)+'┐');
  862.       IWriteLn(F,'│ '+Pad('Area',Len+3)+Pad('Title',52-Len)+'Files       KBytes │');
  863.       IWriteLn(F,'└'+CharStr('─',75)+'┘');
  864.     END;
  865.     IF Cfg.ListFiles.StatFile <>'' THEN
  866.     BEGIN
  867.       New(FT, Init(Cfg.ListFiles.StatFile, SCreate, Max64k(MaxAvail-1024)));
  868.       IF FT=NIL THEN
  869.       BEGIN
  870.         AddLog('!','Error writing Statistic-file - Ignoring!');
  871.         Exit;
  872.       END;
  873.       FT^.WriteLn('┌'+CharStr('─',75)+'┐');
  874.       FT^.WriteLn('│ '+Pad('Area',Len+3)+Pad('Title',52-Len)+'Files       KBytes │');
  875.       FT^.WriteLn('└'+CharStr('─',75)+'┘');
  876.     END ELSE
  877.       FT:=NIL;
  878.     FOR x:=1 TO AreaNum DO
  879.     BEGIN
  880.       IF IncludeArea(Area^[x]^.Tag^) THEN
  881.       BEGIN
  882.         S:='  '+CPad(Trim(Area^[x]^.tag^),Len)+'   '+CPad(Area^[x]^.Title^,52-Len)+
  883.           LONGINTFORM('#.###',Statistik^[x].Files)+ LongIntForm('  ###.###.###',(Statistik^[x].Bytes DIV 1024));
  884.         IF Cfg.ListFiles.Stat          THEN IWriteLn(F,s);
  885.         IF FT<>NIL THEN FT^.WriteLn(s);
  886.       END;
  887.     END;
  888.     IF Cfg.ListFiles.Stat THEN
  889.     BEGIN
  890.       IWriteLn(F,CharStr('─',77));
  891.       IWriteLn(F,CharStr(' ',Len+5)+Pad('Total for all file-areas',50-Len)+
  892.         LongIntForm('###.###',TotalExisting)+ LongIntForm('  ###.###.###',TotalBytes));
  893.       Close(F);
  894.     END;
  895.     IF FT<>NIL THEN
  896.     BEGIN
  897.       FT^.WriteLn(CharStr('─',77));
  898.       FT^.WriteLn(CharStr(' ',Len+5)+Pad('Total for all file-areas',50-Len)+
  899.                   LongIntForm('###.###',TotalExisting)+ LongIntForm('  ###.###.###',TotalBytes));
  900.       WriteFooter(FT);
  901.       Dispose(FT, Done);
  902.     END;
  903.   END;
  904.  
  905.   PROCEDURE InsertTop(CONST FName: PathStr; Start: LongInt);
  906.   VAR
  907.     x : Integer;
  908.     f : FILE;
  909.     Len : Byte;
  910.   BEGIN
  911.     IF Cfg.BBS.BBSType=btMax THEN Len:=9 ELSE Len:=3;
  912.     Arrow(6);
  913.     Assign(F,fName);FileMode:=ShareWrite+ShareDenyW;
  914.     Reset(F,1);
  915.     IF IOResult=0 THEN
  916.     BEGIN
  917.       Seek(F,Start);
  918.       IWriteLn(F,'                           TOP-'+TrimSpaces(LongIntForm('##',Cfg.ListFiles.Top))+
  919.                  ' downloaded files:');
  920.       IWriteLn(F,CharStr('─',78));
  921.       FOR x:= 1 TO Cfg.ListFiles.Top DO
  922.       BEGIN
  923.         IF (Cfg.BBS.BBSType=btMax) AND (Length(TopFiles^[x].Name)>0) AND (TopFiles^[x].Name[14]='/') THEN
  924.         BEGIN
  925.           i:=Pos(' ',copy(TopFiles^[x].Name,14,255));
  926.           IF i>0 THEN Delete(TopFiles^[x].Name,14,i) ELSE TopFiles^[x].Name:=copy(TopFiles^[x].Name,1,12);
  927.         END;
  928.         IF topFiles^[x].Area <> 0 THEN
  929.           IWriteLn(F,LongIntForm('##  ',x)+CPad(TopFiles^[x].Name,63-len)+
  930.             '  Area: ('+CPad(Trim(Area^[topFiles^[x].Area]^.Tag^), Len)+')');
  931.       END;
  932.       IWriteLn(F,CharStr('─',78));
  933.       Close(F);
  934.     END;
  935.   END;
  936.  
  937.   PROCEDURE WriteTop;
  938.   VAR
  939.     F_Top    : PBufTextFile;
  940.     x        : Integer;
  941.     Len      : Byte;
  942.   BEGIN
  943.     IF Cfg.BBS.BBSType=btMax THEN Len:=9 ELSE Len:=3;
  944.     Arrow(6);
  945.     New(F_Top, Init(Cfg.ListFiles.TopFile, SCreate, Max64k(MaxAvail-1024)));
  946.     IF F_Top<>NIL THEN
  947.     BEGIN
  948.       F_Top^.WriteLn('                           TOP-'+Long2Str(Cfg.ListFiles.Top)+' downloaded files:');
  949.       F_Top^.WriteLn(CharStr('─',78));
  950.       FOR x:= 1 TO Cfg.ListFiles.Top DO
  951.       BEGIN
  952.         IF (Cfg.BBS.BBSType=btMax) AND (Length(TopFiles^[x].Name)>0) AND (TopFiles^[x].Name[14]='/') THEN
  953.         BEGIN
  954.           i:=Pos(' ',copy(TopFiles^[x].Name,14,255));
  955.           IF i>0 THEN Delete(TopFiles^[x].Name,14,i) ELSE TopFiles^[x].Name:=copy(TopFiles^[x].Name,1,12);
  956.         END;
  957.         IF topFiles^[x].Area <> 0 THEN
  958.           F_Top^.WriteLn(LongIntForm('##  ',x)+CPad(TopFiles^[x].Name,63-len)+
  959.                          '  Area: ('+CPad(Trim(Area^[topFiles^[x].Area]^.Tag^),len)+')');
  960.       END;
  961.       F_Top^.WriteLn(CharStr('─',78));
  962.       WriteFooter(F_Top);
  963.       Dispose(F_Top, Done);
  964.     END ELSE
  965.       AddLog('!','Error writing TopList - Ignoring!');
  966.   END;
  967.  
  968.   Procedure MakeSegments;
  969.   Var
  970.     F_Segment       : PBufTextFile;
  971.     s               : String;
  972. {   F_MFS           : TNetFile;}
  973.     FileListSegment : TFileListSegment;
  974.  
  975.     PROCEDURE Add2Segment(Seg1,Seg2:LongInt);
  976.     BEGIN
  977.       F_LIST^.Seek(Seg1);
  978.       While (F_LIST^.GetPos < Seg2) DO
  979.       BEGIN
  980.         F_LIST^.ReadLn(s);
  981.         F_Segment^.WriteLn(s);
  982.       END;
  983.     END;
  984.  
  985.     Function FindAreaStart(Tag : String):LongInt;
  986.     VAR
  987.       x             : Longint;
  988.       FoundVal      : LongInt;
  989.     BEGIN
  990.       FoundVal := 0;
  991.       For x := 1 to AreaNum do
  992.       BEGIN
  993.         If StUpCase(Trim(Area^[x]^.Tag^)) = Tag then
  994.           FoundVal := X;
  995.       END;
  996.       FindAreaStart := FoundVal;
  997.     END;
  998.  
  999.     PROCEDURE ProcessSegment;
  1000.     Var
  1001.       ss            : String;
  1002.       SWord         : String;
  1003.       WordNum       : Byte;
  1004.       SegStart      : LongInt;
  1005.       SegSlut       : LongInt;
  1006.     BEGIN
  1007.       New(F_Segment,Init(FileListSegment.FileName,SCreate,Max64K((MaxAvail-2048) DIV 2)));
  1008.  
  1009.       IF (FileListSegment.HeaderFile<>'') AND (ExistFile(FileListSegment.HeaderFile)) THEN
  1010.       BEGIN
  1011.         New(F_Tmp, Init(FileListSegment.HeaderFile, SOpenRead+ShareDenyW, Max64k(MaxAvail-2048)));
  1012.         IF F_Tmp<>NIL THEN
  1013.         BEGIN
  1014.           AddFile(F_Tmp, F_Segment);
  1015.           Dispose(F_Tmp, Done);
  1016.         END;
  1017.       END;
  1018.  
  1019.       With FileListSegment do
  1020.         ss:=StUpCase(IncludeAreas[1]+' '+IncludeAreas[2]+' '+IncludeAreas[3]+' '+IncludeAreas[4]);
  1021.       WordNum:=0;
  1022.       Repeat
  1023.         Inc(WordNum);
  1024.         sWord := ExtractWord(WordNum,ss,[' ']);
  1025.         If sWord <> '' then
  1026.         BEGIN
  1027.           SegStart := FindAreaStart(SWord);
  1028.           If (SegStart <>0) and (Statistik^[SegStart].Pos<>0) then
  1029.           BEGIN
  1030.             If ExtractWord(WordNum+1,ss,[' '])='-' then
  1031.             BEGIN
  1032.               Inc(WordNum,2);
  1033.               sWord := ExtractWord(WordNum,ss,[' ']);
  1034.               If sWord <> '' then
  1035.                 SegSlut := FindAreaStart(sWord) + 1
  1036.               ELSE
  1037.               BEGIN
  1038.                 AddLog('!','MultiList Area not found: '+sWord);
  1039.                 SegSlut := SegStart+1;
  1040.               END;
  1041.             END ELSE
  1042.               SegSlut := SegStart+1;
  1043.             While (Statistik^[SegSlut].Pos = 0) and (SegSlut<AreaNum) do
  1044.               Inc(SegSlut);
  1045.             If SegSlut > AreaNum then
  1046.               SegSlut := FooterStartPos
  1047.             ELSE
  1048.               SegSlut := Statistik^[SegSlut].Pos;
  1049. {   AddLog('!','Writing Segment: '+FileListSegment.Name+' :'+LongIntForm('###.###.###',
  1050.     Statistik^[SegStart].pos)+' -'+LongIntForm('###.###.###',SegSlut)); }
  1051.             Add2Segment(Statistik^[SegStart].pos,SegSlut);
  1052.           END ELSE
  1053.             AddLog('!','MultiList Area Not Found: '+sWord);
  1054.         END;
  1055.       UNTIL sWord = '';
  1056.       PopFooter(F_Segment, False);
  1057.       Dispose(F_Segment, Done);
  1058.     END;
  1059.  
  1060.   BEGIN
  1061.     Arrow(4);
  1062.     New(F_LIST,INIT(Cfg.ListFiles.FileList,SOpenRead+ShareDenyW,Max64K((MaxAvail-2048) DIV 3)));
  1063.     IF F_LIST<>NIL THEN
  1064.     BEGIN
  1065.       OkFile.Open(StartPath+PoPListSegmentsName,SizeOf(TFileListSegment),True);
  1066.       While Not OkFile.EOF do
  1067.       BEGIN
  1068.         OkFile.Read(FileListSegment, NoKeep,Wait) ;
  1069.         AddLog('*', 'MultiList Segment: '+FileListSegment.Name);
  1070.         ProcessSegment;
  1071.         IF FileListSegment.Doafter<>'' THEN RunCmd(FileListSegment.DoAfter,JustPathname(FileListSegment.FileName));
  1072.       END;
  1073. {     F_MFS.Close;}
  1074.       Dispose(F_List, Done);
  1075.     END;
  1076.   END;
  1077.  
  1078.   BEGIN
  1079. {$IFNDEF PoPLite}
  1080.     FreeUpMemory;
  1081.     ShowScreen(True);
  1082.     Arrow(1);
  1083.     TotalFiles:=0;
  1084.     TotalMissing:=0;
  1085.     TotalExisting:=0;
  1086.     TotalBytes:=0;
  1087.     FilesInArea:=0;
  1088.     MissingInArea:=0;
  1089.     ExistingInArea:=0;
  1090.     BytesInArea:=0;
  1091.     NumDupes:=0;
  1092.     ViHarSnydt:=False;
  1093.     AddLog('*','PoP-List: Generating FileList');
  1094.     IF (Cfg.ListFiles.DoBefore<>'') THEN RunCmd(Cfg.Listfiles.DoBefore,StartPath);
  1095.     IF Cfg.ListFiles.DkDate THEN DatePicture:='dd-mm-yy' ELSE DatePicture:='mm-dd-yy';
  1096.     New(Statistik);
  1097.     New(AreaFreqLevel);
  1098.     New(FilesBBS);
  1099.     New(TopFiles);
  1100.     New(Files);
  1101.     New(Area);
  1102.     FillChar(TopFiles^,SizeOf(TopFilesRec)*TopMax,0);
  1103.     FillChar(Statistik^,SizeOf(StatistikRec)*Maxareas,0);
  1104.     AreaNum:=ReadFileAreas(Area);
  1105.     IF Cfg.AreaMan.AddInbound THEN DEC(AreaNum,3);
  1106.     IF Cfg.ListFiles.OkBimodemPath <> '' THEN
  1107.     BEGIN
  1108.       New(F_OKBim, Init(Cfg.ListFiles.OkBimodemPath, SCreate, 1024));
  1109.       IF F_OKBim=NIL THEN AddLog('!','Error writing BiModem OK-file - Ignoring!');
  1110.     END ELSE
  1111.       F_OKBim:=NIL;
  1112.     CheckPortalOkFile;
  1113.     IF MaxAvail>128000 THEN BufSiz:=Max64k((MaxAvail-128000) DIV 2) ELSE BufSiz:=1024;
  1114.     New(F_List, Init(Cfg.ListFiles.FileList, SCreate, BufSiz));
  1115.  
  1116.     DoDupeCheck:=Cfg.ListFiles.DupeCheck;
  1117.     IF DodupeCheck AND (Maxavail<65535) THEN
  1118.     BEGIN
  1119.       AddLog('!','Not enough memory for DupeCheck - Ignoring!');
  1120.       DoDupeCheck:=False;
  1121.     END;
  1122.     IF DoDupeCheck THEN
  1123.       Dupes.Init(MaxDupes, 1, SizeOf(TDupeRec), '$DUPES.SRT', (MaxAvail-2048) DIV 3, lDeleteFile, DefaultPriority);
  1124.     IF (IOResult=0) AND (Cfg.ListFiles.FileList<>'') THEN
  1125.     BEGIN
  1126.       IF (Cfg.ListFiles.Header<>'') AND ExistFile(Cfg.ListFiles.Header) THEN
  1127.       BEGIN
  1128.         Assign(F_File,Cfg.ListFiles.Header);FileMode:=ShareRead+ShareDenyNone;
  1129.         Reset(F_File,1);
  1130.         IF IOResult=0 THEN
  1131.         BEGIN
  1132.           StatStart:=FileSize(F_File)+4;
  1133.           Close(F_File);
  1134.         END;
  1135.         New(F_Tmp, Init(Cfg.ListFiles.Header, SOpenRead+ShareDenyW, Max64k(MaxAvail-1024)));
  1136.         IF F_Tmp<>NIL THEN
  1137.         BEGIN
  1138.           AddFile(F_Tmp,F_List);
  1139.           Dispose(F_Tmp, Done);
  1140.         END;
  1141.         F_List^.WriteLn('');
  1142.         F_List^.WriteLn('');
  1143.       END ELSE
  1144.         StatStart:=0;
  1145.       IF Cfg.ListFiles.Stat THEN
  1146.       BEGIN
  1147.         FOR i:= 1 TO AreaNum+6 DO
  1148.           F_List^.WriteLn(CharStr(' ',79));
  1149.         TopStart:=StatStart+(AreaNum+6)*81
  1150.       END Else
  1151.         TopStart:=StatStart;
  1152.       IF (Cfg.ListFiles.top<>0) AND Cfg.ListFiles.IncludeTop THEN
  1153.         FOR i:= 1 TO Cfg.ListFiles.Top+3 DO F_List^.WriteLn(Pad('',79));
  1154.       IF Cfg.ListFiles.NewsDays <> 0 THEN
  1155.       BEGIN
  1156.         New(F_News, Init(Cfg.ListFiles.NewsList, SCreate, BufSiz));
  1157.         IF F_News=NIL THEN
  1158.         BEGIN
  1159.           AddLog('!','Error writing News-List - Ignoring!');
  1160.         END Else
  1161.         BEGIN
  1162.           F_News^.WriteLn('              New files from the past '+Long2Str(Cfg.ListFiles.NewsDays)+' days.');
  1163.           F_News^.WriteLn('');
  1164.         END;
  1165.       END ELSE
  1166.         F_News:=NIL;
  1167.       FOR i:=1 TO AreaNum DO
  1168.       BEGIN
  1169.         IF IncludeArea(Area^[i]^.Tag^) THEN
  1170.         BEGIN
  1171.           UpdateScreen;
  1172.           ProcessFilesBBS(i);
  1173.           IF F_OkBim<>NIL THEN F_OkBim^.WriteLn(Area^[i]^.Path^);
  1174.           IF GotEsc THEN
  1175.           BEGIN
  1176.             AddLog('!','PoP-List: Generation aborted by user, using His/Her/Its own hands');
  1177.             ViHarSnydt:=True;
  1178.             GOTO SnydeFidus;
  1179.           END;
  1180.         END;
  1181.       END;
  1182. SnydeFidus:
  1183.       Arrow(6);
  1184.       FooterStartPos:=F_LIST^.GetPos;
  1185.       IF Cfg.ListFiles.Footer<>'' THEN
  1186.       BEGIN
  1187.         New(F_Tmp, Init(Cfg.ListFiles.Footer, SOpenRead+ShareDenyW, Max64k(MaxAvail-1024)));
  1188.         IF F_Tmp<>NIL THEN
  1189.         BEGIN
  1190.           AddFile(F_Tmp,F_List);
  1191.           Dispose(F_Tmp, Done);
  1192.         END;
  1193.         F_List^.WriteLn('');
  1194.         F_List^.WriteLn('');
  1195.       END;
  1196.       PopFooter(F_List, NOT Cfg.ListFiles.Stat);
  1197.       IF Cfg.ListFiles.NewsDays<>0 THEN PopFooter(F_News,False);
  1198.       Dispose(F_List, Done);
  1199.       IF F_News<>NIL THEN Dispose(F_News, Done);
  1200.       IF (Cfg.ListFiles.StatFile <>'') OR Cfg.ListFiles.Stat THEN
  1201.         InsertStat(Cfg.ListFiles.FileList,StatStart);
  1202.       IF Cfg.ListFiles.IncludeTop AND (Cfg.ListFiles.Top <> 0) THEN InsertTop(Cfg.ListFiles.FileList,TopStart);
  1203.       IF (Cfg.ListFiles.Top <> 0) AND (Cfg.ListFiles.TopFile <> '') THEN WriteTop;
  1204.     END ELSE
  1205.     BEGIN
  1206.       AddLog('!','Error writing FileList - Aborting!');
  1207.       ViHarSnydt:=True;
  1208.     END;
  1209.     Arrow(5);
  1210.     IF DoDupeCheck THEN
  1211.     BEGIN
  1212.       IF NOT ViHarSnydt THEN CheckDupeFile;
  1213.       Dupes.Done;
  1214.     END;
  1215.  
  1216. {--}MakeSegments;
  1217. {$IFDEF MSGOBJECT}
  1218.     PostStatMsg;
  1219. {$ENDIF}
  1220.     DisposeFileAreas(Area,AreaNum);
  1221.     Dispose(Area);
  1222.     Dispose(Files);
  1223.     Dispose(TopFiles);
  1224.     Dispose(FilesBBS);
  1225.     Dispose(Statistik);
  1226.     Dispose(AreaFreqLevel);
  1227.     IF F_OkBim<>NIL THEN Dispose(F_OkBim, Done);
  1228.     IF NOT ViHarSnydt THEN
  1229.     BEGIN
  1230.       IF Cfg.ListFiles.DoPack<>'' THEN RunCmd(Cfg.Listfiles.DoPack,JustPathname(Cfg.ListFiles.FileList));
  1231.       IF Cfg.ListFiles.DoAfter<>'' THEN RunCmd(Cfg.Listfiles.DoAfter,StartPath);
  1232.       AddLog('*','PoP-List: Generation complete');
  1233.     END;
  1234.     Arrow(0);
  1235.     ShowScreen(False);
  1236.     InitialiseNodelist(cfg.NodeList,cfg.nodelisttyp);
  1237. {$ELSE}
  1238.     AddLog('!','Not implemented in Portal of Power/Lite');
  1239. {$ENDIF}
  1240.   END;
  1241.  
  1242. END.
  1243.